Celestin Apprentice 7/Apprentice-Release7.iso/Source Code/Pascal/Snippets/PNL Libraries/MyAFPAsyncs.p

Text File | 1997-01-10 | 4.6 KB | 211 lines | [TEXT/CWIE]

unit MyAFPAsyncs;

interface

    uses
        AppleTalk;

    type
        XPPXParamBlockRec = record
                qLink: XPPXParmBlkPtr;
                realResult: OSErr;
                pad: integer;
                your_completion: ProcPtr;
                my_completion: ProcPtr;
                pb: XPPParamBlock;
            end;
        XPPXParmBlkPtr = ^XPPXParamBlockRec;

    procedure AFPControlAsync (xppx: XPPXParmBlkPtr; comp: ProcPtr);
    function XPPToXPPX( xpp: XPPParmBlkPtr ): XPPXParmBlkPtr;
    procedure StartupAFPAsyncs;

implementation

    uses
        Devices, PreserveA5, MyTypes, MyAssertions, MyStartup, MyCallProc, MyMemory;

    const
        preheader_size = 16;
    var
        gMyCompletion: UniversalProcPtr;
        afpque: QHdr;
        tokenque: QHdr;
        token: QElem;

    function XPPToXPPX( xpp: XPPParmBlkPtr ): XPPXParmBlkPtr;
        var
            xppx: XPPXParmBlkPtr;
    begin
        Assert( xpp <> nil );
        xppx := XPPXParmBlkPtr(longint(xpp) - preheader_size);
        Assert( xppx <> nil );
        XPPToXPPX := xppx;
    end;

    procedure PutToken;
    begin
        Assert( tokenque.qHead = nil );
        Enqueue( @token, @tokenque );
    end;

    function GetToken: boolean;
        var
            elem: QElemPtr;
    begin
        GetToken := false;
        elem := tokenque.qHead;
        if elem <> nil then begin
            GetToken := Dequeue( elem, @tokenque ) = noErr;
        end;
    end;

{$ifc 0 & do_debug}
{$definec ValidateState ValidateStateCode}
{$elsec}
{ buggy compiler $ d efinec Assert(b)}
{$definec ValidateState if false then begin end else begin end }
{$endc}

{$ifc do_debug}
    procedure ValidateStateCode;
        var
            xppx: XPPXParmBlkPtr;
    begin
        Assert( (tokenque.qHead = nil) <> (afpque.qHead = nil) ); { technically subject to race condition }
        Assert( ((tokenque.qHead = nil) & (tokenque.qTail = nil)) | ((tokenque.qHead = @token) & (tokenque.qTail = @token)) );
        xppx := XPPXParmBlkPtr(afpque.qHead);
        while xppx <> nil do begin
            Assert( xppx^.pb.ioResult = -9999 );
            Assert( xppx^.realResult = inProgress );
            Assert( xppx^.your_completion = nil );
            xppx := xppx^.qLink;
        end;
    end;
{$endc}

    procedure StartNextCommand;
        var
            xppx: XPPXParmBlkPtr;
            junk: OSErr;
    begin
        xppx := XPPXParmBlkPtr( afpque.qHead );
        if xppx <> nil then begin
            Assert( xppx^.your_completion = nil );
            junk := PBControlAsync( @xppx^.pb );
        end else begin
            PutToken;
        end;
    end;

    procedure MyCompletion(pbp: XPPParmBlkPtr);
        var
            xppx: XPPXParmBlkPtr;
            comp: UniversalProcPtr;
            junk: OSErr;
    begin
        xppx := XPPToXPPX( pbp );
        Assert( afpque.qHead = QElemPtr(xppx) );
        comp := xppx^.your_completion;
        junk := Dequeue( QElemPtr(xppx), @afpque );
        Assert( junk = noErr );
        MTrash( xppx, preheader_size );

        xppx^.realResult := xppx^.pb.ioResult;
{$ifc do_debug}
        xppx^.pb.ioResult := -9999;
{$endc}
        if comp <> nil then begin
            CallPascal04( pbp, comp );
        end;

        StartNextCommand;

        ValidateState;
    end;

    procedure AFPControlAsync (xppx: XPPXParmBlkPtr; comp: ProcPtr);
        var
            junk: OSErr;
    begin
        ValidateState;

        Assert( xppx <> nil );
        Assert( gMyCompletion <> nil );
        junk := Dequeue( QElemPtr(xppx), @afpque );
        Assert( junk <> noErr );
        Assert( xppx^.pb.qLink = nil );
        xppx^.your_completion := comp;
        xppx^.my_completion := gMyCompletion;
        xppx^.pb.ioCompletion := gPreCompletionProc;
        xppx^.pb.ioResult := inProgress;
{$ifc do_debug}
        xppx^.pb.ioResult := -9999;
{$endc}
        xppx^.realResult := inProgress;
        xppx^.pb.csCode := afpCall;
        Enqueue( QElemPtr(xppx), @afpque );
        if GetToken then begin
            StartNextCommand;
        end;
    end;

    procedure IdleAFPAsyncs;
    begin
        ValidateState;
    end;

    function InitAFPAsyncs( var msg: integer ): OSStatus;
    begin
{$unused(msg)}
        afpque.qFlags := 0;
        afpque.qHead := nil;
        afpque.qTail := nil;
        tokenque.qFlags := 0;
        tokenque.qHead := nil;
        tokenque.qTail := nil;
        PutToken;
        gMyCompletion := NewIOCompletionProc(@MyCompletion);
        InitAFPAsyncs := noErr;
    end;

    procedure StartupAFPAsyncs;
    begin
        StartupPreserveA5;
        SetStartup( InitAFPAsyncs, IdleAFPAsyncs, 15, nil );
    end;

end.
(*
    procedure AFPControlAsync (xppx: XPPXParmBlkPtr; comp: ProcPtr);
        var
            junk: OSErr;
    begin
        if comp <> nil then begin
            xppx^.my_completion := comp;
            xppx^.pb.ioCompletion := gPreCompletionProc;
        end else begin
            xppx^.pb.ioCompletion := nil;
        end;
        xppx^.pb.csCode := afpCall;
        if xppx^.pb.qLink <> nil then begin
            DebugStr('AFP Assert Failed;sc;hc');
        end;
        junk := PBControlAsync(@xppx^.pb);
    end;

                afp_in_progress := true;
                junk := Dequeue( QElemPtr(xppx), @afpque );
                Assert( junk = noErr );
                MTrash( xppx, 4 ); { qLink }
                Assert( current_request = nil );
                current_request := xppx;
        current_request := nil;
        if current_request <> nil then begin
            Assert( current_request^.pb.ioResult = inProgress );
        end;
        Assert( current_request <> xppx );



*)